home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / drawer.zip / DIALOG.PAS < prev    next >
Pascal/Delphi Source File  |  1993-01-04  |  3KB  |  132 lines
  1. unit Dialogs;
  2.  
  3. interface
  4.  
  5. uses MSGraph;
  6.  
  7. type
  8.     Prompter =    object
  9.                     r, c : word;        { position }
  10.                     ce : word;            { size (in columns) }
  11.                     prompt : string;    { prompt string }
  12.                     resp : string;    { response string }
  13.                     procedure Initialize( r, c, ce : word; p : string);
  14.                     function Process: boolean;
  15.                     function  Response: string;
  16.                 end;
  17.  
  18.     procedure InitDialogManager( var vc : _VideoConfig );
  19.  
  20. implementation
  21.  
  22. uses Crt;
  23.  
  24. const
  25.     cx : word = 640 div 80;
  26.     cy : word = 350 div 25;
  27.  
  28. procedure InitDialogManager( var vc : _VideoConfig );
  29. begin
  30.     cx := vc.numxpixels div 80;
  31.     cy := vc.numypixels div 25;
  32. end;
  33.  
  34. procedure Prompter.Initialize( r, c, ce : word; p : string);
  35. begin
  36.     self.r := r;
  37.     self.c := c;
  38.     self.ce := ce;
  39.     self.prompt := p;
  40. end;
  41.  
  42. function printable( ch : char ) : boolean;
  43. begin
  44.     printable := ch>=' ';
  45. end;
  46.  
  47. function MyRead( var s : string; max : word ) : boolean;
  48. const
  49.     NUL = chr(0);
  50.     BS  = chr(8);
  51.     CR  = chr(13);
  52.     ESC = chr(27);
  53.     BEL = chr(7);
  54. var
  55.     ch : char;
  56. begin
  57.     s := '';
  58.     repeat
  59.         write('_'+chr(8));
  60.         ch := Readkey;
  61.         case ch of
  62.             NUL :    begin
  63.                         ch := Readkey;
  64.                         { case ch of
  65.                           end;
  66.                         }
  67.                     end;
  68.             BS :    begin
  69.                         if length(s)>0 then begin
  70.                             write(' '+BS+BS);
  71.                             s := copy(s, 1, length(s)-1);
  72.                             end
  73.                         else write(BEL);
  74.                     end;
  75.             ESC :     begin
  76.                         MyRead := FALSE;
  77.                         exit;
  78.                     end;
  79.             CR  :    begin
  80.                         MyRead := TRUE;
  81.                         exit;
  82.                     end;
  83.             else    begin
  84.                         if printable(ch) and (length(s)<max) then begin
  85.                             write(ch);
  86.                             s := s + ch
  87.                             end;
  88.                     end;
  89.             end;
  90.     until FALSE;
  91. end;
  92.  
  93. function Prompter.Process : boolean;
  94. var
  95.     numbytes : word;
  96.     x1, y1, x2, y2 : word;
  97.     bitmap : pointer;
  98. begin
  99.     with self do begin
  100.         x1 := (c-1)*cx;
  101.         y1 := (r-1)*cy;
  102.         x2 := x1+(ce+3)*cx;
  103.         y2 := y1+5*cy;
  104.         numbytes := _ImageSize( x1, y1, x2, y2);
  105.         GetMem( bitmap, numbytes);
  106.         _GetImage( x1, y1, x2, y2, bitmap^);
  107.         _setcolor(0);
  108.         _rectangle( _GFILLINTERIOR, x1, y1, x2, y2);
  109.         _setcolor(255);
  110.         _SetLineStyle($FFFF);
  111.         _rectangle( _GBORDER, x1, y1, x2, y2);
  112.         _SetTextPosition( r+1, c+1);
  113.         _OutText( prompt );
  114.         _rectangle( _GBORDER, c*cx-3, (r+2)*cy-1, (c+ce+1)*cx+3, (r+3)*cy);
  115.         _SetTextPosition( r+3, c+1);
  116.         Process := MyRead( self.resp, ce);
  117.         _PutImage( x1, y1, bitmap^, _GPSET);
  118.         FreeMem( bitmap, numbytes);
  119.         end;
  120. end;
  121.  
  122. function Prompter.Response : string;
  123. begin
  124.     Response := self.Resp;
  125. end;
  126.  
  127.  
  128.  
  129. begin
  130.     DirectVideo := FALSE;
  131. end.
  132.